home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / ActiveX Controlls / XP Suite / DATA1.CAB / XP_Panel_Sample_Files / cArchive.cls next >
Encoding:
Visual Basic class definition  |  2003-04-24  |  40.4 KB  |  909 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cArchive"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' Major rewrite 30-May-2001. Handles Ace, Cab, Rar, Zip archives
  16. ' in just one class (easily expandable to accomodate other formats)
  17. ' Common event now returns Total # of files for use in progress bars.
  18. ' Zip and Cab are enumerated using NO 3rd party Dll's.
  19. ' Ace and Rar use UnAce.Dll and UnRar.Dll respectively.
  20. '
  21. ' Dec 2001. Added network support.
  22.  
  23. 'To Do:
  24. ' Complete Zip/Unzip support(Done - not included in this demo)
  25. ' Finish UnAce/UnRar decompress.
  26. ' Write code to compress Ace/Rar (need Dll's)
  27. ' Write compress/decompress for Cab using Cabinet.Dll
  28. ' instead of setupapi.dll
  29. '
  30. 'Set ArchiveName/ArchiveExt after instantiating class
  31. Public ArchiveName As String  'Compressed FileName to open
  32. Public ArchiveExt As String    'Ext of Archive (ace,cab,rar,zip)
  33. 'Returns total # of files - included in all FileFound events
  34. Public FileCount As Long      'Total
  35.  
  36. Private Type ZipFileCentralHeader
  37.   VersionMadeBy            As Integer
  38.   VersionNeededToExtract   As Integer
  39.   Flag                     As Integer
  40.   CompressionMethod        As Integer
  41.   time                     As Integer
  42.   date                     As Integer
  43.   CRC32                    As Long
  44.   CompressedSize           As Long
  45.   UncompressedSize         As Long
  46.   FileNameLength           As Integer
  47.   ExtraFieldLength         As Integer
  48.   FileCommentLength        As Integer
  49.   DiskNumberStart          As Integer
  50.   InternalAttr             As Integer
  51.   ExternalAttr             As Long
  52.   RelOffsetLocHdr          As Long
  53.   Filename                 As String
  54.   ExtraField               As String
  55.   FileComment              As String
  56. End Type
  57. Private Type ZipFileEndCentralHeader
  58.   DiskNumberThis             As Integer
  59.   DiskNumberCentralDir       As Integer
  60.   CentralDirEntriesThisDisk  As Integer
  61.   CentralDirEntriesTotal     As Integer
  62.   SizeCentralDir             As Long
  63.   CentralDirOffset           As Long
  64.   FileCommentLength          As Integer
  65.   FileComment                As String
  66. End Type
  67. Private Type ZipDigitalSignature
  68.    SignatureSize  As Integer
  69.    signature      As String
  70. End Type
  71.  
  72. 'Private Type ZipFileLocalHeader
  73. '  Version            As Integer
  74. '  Flag               As Integer
  75. '  CompressionMethod  As Integer
  76. '  Time               As Integer
  77. '  Date               As Integer
  78. '  CRC32              As Long
  79. '  CompressedSize     As Long
  80. '  UncompressedSize   As Long
  81. '  FileNameLength     As Integer
  82. '  ExtraFieldLength   As Integer
  83. '  FileName           As String
  84. '  ExtraField         As String
  85. 'End Type
  86. Private Type ACEOPENARCHIVEDATA
  87.     Arcname As Long
  88.     OpenMode As Long
  89.     OpenResult As Long
  90.     flags As Long
  91.     Host As Long
  92.     AV As String * 51
  93.     CmtBuf As Long      'Pointer to buffer ??
  94.     CmtBufSize As Long
  95.     CmtSize As Long
  96.     CmtState As Long
  97.     ChangeVolProc As Long
  98.     ProcessDataProc As Long
  99. End Type
  100.  
  101. Private Type ACEHEADERDATA
  102.     Arcname As String * MAX_PATH
  103.     Filename As String * MAX_PATH
  104.     flags As Long
  105.     PackSize As Long
  106.     UnpSize As Long
  107.     FileCRC As Long
  108.    'was FileTime As Long
  109.     FileTime As Integer
  110.     FileDate As Integer
  111.     Method As Long
  112.     QUAL As Long
  113.     FileAttr As Long
  114.     CmtBuf As Long      'Pointer to buffer
  115.     CmtBufSize As Long
  116.     CmtSize As Long
  117.     CmtState As Long
  118. End Type
  119.  
  120. Private Type typCHANGEVOLPROC
  121.     Arcname As String
  122.     Mode As Long
  123. End Type
  124.  
  125. Private Type typPROCESSDATAPROC
  126.     Addr As String
  127.     Size As Long
  128. End Type
  129.  
  130. 'Private Const ACEERR_MEM = 1
  131. 'Private Const ACEERR_FILES = 2
  132. 'Private Const ACEERR_FOUND = 3
  133. 'Private Const ACEERR_FULL = 4
  134. 'Private Const ACEERR_OPEN = 5
  135. 'Private Const ACEERR_READ = 6
  136. Private Const ACEERR_WRITE = 7
  137. 'Private Const ACEERR_CLINE = 8
  138. Private Const ACEERR_CRC = 9
  139. 'Private Const ACEERR_OTHER = 10
  140. 'Private Const ACEERR_EXISTS = 11
  141. 'Private Const ACEERR_END = 128
  142. 'Private Const ACEERR_HANDLE = 129
  143. 'Private Const ACEERR_CONSTANT = 130
  144. 'Private Const ACEERR_NOPASSW = 131
  145. 'Private Const ACEERR_METHOD = 132
  146. 'Private Const ACEERR_USER = 255
  147.  
  148. 'Const SUCCESS = 0&
  149.  
  150. Private Const ACEOPEN_LIST = 0
  151. Private Const ACEOPEN_EXTRACT = 1
  152.  
  153. Private Const ACECMD_SKIP = 0
  154. Private Const ACECMD_TEST = 1
  155. Private Const ACECMD_EXTRACT = 2
  156.  
  157. 'Private Const ACEVOL_REQUEST = 0
  158. 'Private Const ACEVOL_OPENED = 1
  159.  
  160. Private Declare Function ACEOpenArchive Lib "unACE.dll" _
  161.                     (ByRef Archivedata As ACEOPENARCHIVEDATA) As Long
  162. Private Declare Function ACEProcessFile Lib "unACE.dll" _
  163.                     (ByVal hArcData As Long, _
  164.                      ByVal Operation As Long, _
  165.                      ByVal DestPath As String) As Long
  166. Private Declare Function ACECloseArchive Lib "unACE.dll" _
  167.                     (ByVal hArcData As Long) As Long
  168. Private Declare Function ACEReadHeader Lib "unACE.dll" _
  169.                     (ByVal hArcData As Long, _
  170.                      ByRef Headerdata As ACEHEADERDATA) As Long
  171. Private Type CabFileHeader
  172.     signature     As String * 4  ' MSCF (cabinet file signature )
  173.     reserved1     As Long        '
  174.     cbCabinet     As Long        'size of this cabinet file in bytes
  175.     reserved2     As Long        '
  176.     coffFiles     As Long        'offset of the first CFFILE entry
  177.     reserved3     As Long        '
  178.     versionMinor  As Byte        'cabinet file format version, minor
  179.     versionMajor  As Byte        'cabinet file format version, major
  180.     cFolders      As Integer     'number of CFFOLDER entries in this cabinet
  181.     cFiles        As Integer     'number of CFFILE entries in this cabinet
  182.     flags         As Integer     'cabinet file option indicators
  183.     setID         As Integer     'must be the same for all cabinets in a set
  184.     iCabinet      As Integer     'number of this cabinet file in a set
  185.   '  cbCFHeader    As Integer     '(optional) size of per-cabinet reserved area
  186.   '  cbCFFolder    As Byte        '(optional) size of per-folder reserved area
  187.   '  cbCFData      As Byte        '(optional) size of per-datablock reserved area
  188.   '  abReserve     As Byte        '(optional) per-cabinet reserved area
  189.   '  szCabinetPrev As Byte        '(optional) name of previous cabinet file
  190.   '  szDiskPrev    As Byte        '(optional) name of previous disk
  191.   '  szCabinetNext As Byte        '(optional) name of next cabinet file
  192.   '  szDiskNext    As Byte        '(optional) name of next disk
  193. End Type
  194.  
  195. Private Type CFFOLDER
  196.     coffCabStart  As Long     'offset of the first CFDATA block in this folder
  197.     cCFData       As Integer  'number of CFDATA blocks in this folder
  198.     typeCompress  As Integer  'compression type indicator
  199. End Type
  200.  
  201. Private Type CFFILE
  202.     uSize            As Long     'uncompressed size of this file in bytes
  203.     uoffFolderStart  As Long     'uncompressed offset of this file in the folder
  204.     iFolder          As Integer  'index into the CFFOLDER area
  205.     date             As Integer  'date stamp for this file
  206.     time             As Integer  'time stamp for this file
  207.     attribs          As Integer  'attribute flags for this file
  208.     'szName is variable length string with Chr$(0) terminator
  209.     'See GetInfo to see how seek is adjusted for block alignment
  210.     szName           As String * 260  'name of this file
  211. End Type
  212.  
  213. 'Would have been nice if the Crc and
  214. 'Compressed size were in CFFILE above
  215.  
  216. Private Type CFDATA
  217.     csum       As Long    'checksum of this CFDATA entry
  218.     cbData     As Integer 'number of compressed bytes in this block
  219.     cbUncomp   As Integer 'number of uncompressed bytes in this block
  220.   '  abReserve  As Byte    '(optional) per-datablock reserved area
  221.   '  ab[cbData] As Byte    'compressed data bytes
  222. End Type
  223. Private Type RAROPENARCHIVEDATA
  224.     szArcName As Long               ' INPUT: Should point to a zero terminated string containing the archive name
  225.     OpenMode As Long                ' INPUT: RAR_OM_LIST - Open archive for reading file headers only
  226.                                     '        RAR_OM_EXTRACT - Open archive for testing and extracting files
  227.     OpenResult As Long              ' OUTPUT: 0                 - Success
  228.                                     '         ERAR_NO_MEMORY    - Not enough memory to initialize data structures
  229.                                     '         ERAR_BAD_DATA     - Archive header broken
  230.                                     '         ERAR_BAD_ARCHIVE  - File is not a valid RAR archive
  231.                                     '         ERAR_EOPEN        - File open error
  232.     szCmtBuf As Long                ' INPUT: Should point to a buffer for archive comments.
  233.                                     '        Maximum comment size is limited to 64 KB. Comment text is zero termintad.
  234.                                     '        If the comment text is larger than the buffer size, the comment text
  235.                                     '        will be trunctated. If szCmtBuf is set to NULL, comments will not be read.
  236.     CmtBufSize As Long              ' INPUT: Should contain size of buffer for archive comments
  237.     CmtSize As Long                 ' OUTPUT: Containing size of comments actually read into the buffer.
  238.                                     '         Cannot exceed CmtBufSize.
  239.     CmtState As Long                ' State:
  240.                                     ' 0                 - absent comments
  241.                                     ' 1                 - Comments read completely
  242.                                     ' ERAR_NO_MEMORY    - Not enough memory to extract comment
  243.                                     ' ERAR_BAD_DATA     - Broken comment
  244.                                     ' ERAR_UNKNOWN_FORMAT - Unknown comment format
  245.                                     ' ERAR_SMALL_BUF    - Buffer too small, comments not completely read
  246. End Type
  247.  
  248. Private Type RARHEADERDATA
  249.     Arcname As String * MAX_PATH         ' Contains the zero terminated string of the current archive name.
  250.                                     ' Maybe used to determine the current volume name
  251.     Filename As String * MAX_PATH        ' Contains the zero terminated string of the file name
  252.     flags As Long                   ' Flags
  253.                                     ' bits 7 6 5 4 3 2 1 0
  254.                                     '      0 0 0 0 0 0 0 1  &H1&    - file continued from previous volume
  255.                                     '      0 0 0 0 0 0 1 0  &H2&    - file continues on next volume
  256.                                     '      0 0 0 0 0 1 0 0  &H4&    - file encrypted with password
  257.                                     '      0 0 0 0 1 0 0 0  &H8&    - file comment present
  258.                                     '      0 0 0 1 0 0 0 0  &H10&   - compression of previous files is used
  259.                                     '                                 (solid flag)
  260.                                     '      0 0 0 0 0 0 0 0  &H00&   - dictionary size    64 KB
  261.                                     '      0 0 1 0 0 0 0 0  &H20&   - dictionary size   128 KB
  262.                                     '      0 1 0 0 0 0 0 0  &H40&   - dictionary size   256 KB
  263.                                     '      0 1 1 0 0 0 0 0  &H60&   - dictionary size   512 KB
  264.                                     '      1 0 0 0 0 0 0 0  &H80&   - dictionary size  1024 KB
  265.                                     '      1 0 1 0 0 0 0 0  &HA0&   - reserved
  266.                                     '      1 1 0 0 0 0 0 0  &HC0&   - reserved
  267.                                     '      1 1 1 0 0 0 0 0  &HE0&   - file is directory
  268.     PackSize As Long                ' Packed file size or size of the file part if file was split between volumes
  269.     UnpSize As Long                 ' UnPacked file size
  270.     HostOS As Long                  ' Operating system used for archiving
  271.                                     ' 0 - MS DOS
  272.                                     ' 1 - OS/2
  273.                                     ' 2 - Win32
  274.                                     ' 3 - Unix
  275.     FileCRC As Long                 ' unpacked CRC of file. '
  276.                                     ' It should not be used for file parts which were split between volumes.
  277.     'was  FILETIME As Long                ' Date & Time in standardMS-DOS format
  278.     FileTime As Integer
  279.     FileDate As Integer
  280.                                     ' First 16 bits contain date
  281.                                     '   Bits 0 - 4  : day (1-31)
  282.                                     '   Bits 5 - 8  : month (1=January,12=December)
  283.                                     '   Bits 9 - 15 : year (0=1980)
  284.                                     ' Second 16 bits contain time
  285.                                     '   Bits 0 - 4  : number of seconds divided by two
  286.                                     '   Bits 5 - 10 : number of minutes (0-59)
  287.                                     '   Bits 11 - 15: numer of hours (0-23)
  288.     UnpVer As Long                  ' RAR version required to extract the file
  289.                                     ' It is encoded as 10 * Major version + minor version
  290.     Method As Long                  ' Packing method
  291.     FileAttr As Long                ' File attributes
  292.     CmtBuf As Long                  ' INPUT: Should point to a buffer for file comments.
  293.                                     '        Maximum comment size is limited to 64 KB. Comment text is zero termintad.
  294.                                     '        If the comment text is larger than the buffer size, the comment text
  295.                                     '        will be trunctated. If szCmtBuf is set to NULL, comments will not be read.
  296.     CmtBufSize As Long              ' INPUT: Should contain size of buffer for file comments
  297.     CmtSize As Long                 ' OUTPUT: Containing size of comments actually read into the buffer.
  298.                                     '         Should not exceed CmtBufSize.
  299.     CmtState As Long                ' State:
  300.                                     ' 0                 - absent comments
  301.                                     ' 1                 - Comments read completely
  302.                                     ' ERAR_NO_MEMORY    - Not enough memory to extract comment
  303.                                     ' ERAR_BAD_DATA     - Broken comment
  304.                                     ' ERAR_UNKNOWN_FORMAT - Unknown comment format
  305.                                     ' ERAR_SMALL_BUF    - Buffer too small, comments not completely read
  306. End Type
  307.  
  308. ' Error constants
  309. 'Private Const ERAR_END_ARCHIVE = 10&    ' end of archive
  310. 'Private Const ERAR_NO_MEMORY = 11&      ' not enough memory to initialize data structures
  311. 'Private Const ERAR_BAD_DATA = 12&       ' Archive header broken
  312. 'Private Const ERAR_BAD_ARCHIVE = 13&    ' File is not valid RAR archive
  313. 'Private Const ERAR_UNKNOWN_FORMAT = 14& ' Unknown comment format
  314. 'Private Const ERAR_EOPEN = 15&          ' File open error
  315. 'Private Const ERAR_ECREATE = 16&        ' File create error
  316. 'Private Const ERAR_ECLOSE = 17&         ' file close error
  317. Private Const ERAR_EREAD = 18&          ' Read error
  318. Private Const ERAR_EWRITE = 19&         ' Write error
  319. ' Private Const ERAR_SMALL_BUF = 20&      ' Buffer too small, comment weren't read completely
  320.  
  321. ' OpenMode values
  322. Private Const RAR_OM_LIST = 0&           ' Open archive for reading file headers only
  323. Private Const RAR_OM_EXTRACT = 1        ' Open archive for testing and extracting files
  324.  
  325. ' Operation values
  326. Private Const RAR_SKIP = 0&              ' Move to the next file in archive
  327.                                         ' Warning: If the archive is solid and
  328.                                         ' RAR_OM_EXTRACT mode was set when the archive
  329.                                         ' was opened, the current file will be processed and
  330.                                         ' the operation will be performed slower than a simple seek
  331. 'Private Const RAR_TEST = 1&             ' Test the current file and move to the next file in
  332.                                         ' the archive. If the archive was opened with the
  333.                                         ' RAR_OM_LIST mode, the operation is equal to RAR_SKIP
  334. Private Const RAR_EXTRACT = 2&          ' Extract the current file and move to the next file.
  335.                                         ' If the archive was opened with the RAR_OM_LIST mode,
  336.                                         ' the operation is equal to RAR_SKIP
  337.  
  338. ' ChangeVolProc-Mode-parameter-values
  339. 'Private Const RAR_VOL_ASK = 0&          ' Required volume is absent. The function should
  340.                                         ' prompt the user and return non-zero value to retry the
  341.                                         ' operation. The function may also specify a new
  342.                                         ' volume name, placing it to ArcName parameter
  343. 'Private Const RAR_VOL_NOTIFY = 1&       ' Required volume is successfully opened. This is a
  344.                                         ' notification call and ArcName modification is NOT
  345.                                         ' allowed. The function should return non-zero value
  346.                                         ' to continue or a zero value to terminate operation
  347.  
  348. ' Open RAR archive and allocate memory structures (about 1MB)
  349. ' parameters:   ArchiveData     - points to RAROpenArchiveData structure
  350. ' returns:  Archive handle or NULL in case of error
  351. Private Declare Function RAROpenArchive Lib "unrar.dll" _
  352.                 (ByRef Archivedata As RAROPENARCHIVEDATA) As Long
  353.                 
  354.     
  355. ' Close RAR archive and release allocated memory.
  356. ' Is must be called when archive processing is finished, even if the archive processing
  357. ' was stopped due to an error
  358. ' parameters:   hAcrData        - contains the archive handle obtained from the
  359. '                                 RAROpenArchive function call
  360. ' returns:  0 on success or ERAR_ECLOSE on Archive close error
  361. Private Declare Function RARCloseArchive Lib "unrar.dll" _
  362.                 (ByVal hArcData As Long) As Long
  363.                 
  364. ' Read header of file in archive
  365. ' parameters:   hAcrData        - contains the archive handle obtained from the
  366. '                                 RAROpenArchive function call
  367. '               HeaderData      - points to RARHeaderData structure
  368. ' returns:  0                   - Success
  369. '           ERAR_END_ARCHIVE    - End of archive
  370. '           ERAR_BAD_ARCHIVE    - File header broken
  371. Private Declare Function RARReadHeader Lib "unrar.dll" _
  372.                 (ByVal hArcData As Long, _
  373.                  ByRef Headerdata As RARHEADERDATA) As Long
  374.                  
  375. ' Performs action and moves the current position in the archive to the next file.
  376. ' Extract or test the current file from the archive opened in RAR_OM_EXTRACT mode.
  377. ' If the mode RAR_OM_LIST is set, then a call to this function will simply skip
  378. ' the archive position to the next file
  379. ' parameters:   hAcrData        - contains the archive handle obtained from the
  380. '                                 RAROpenArchive function call
  381. '               Operation       - RAR_SKIP  : Move to the next file in the archive.
  382. '                                   If the archive is solid and RAR_OM_EXTRACT mode
  383. '                                   was set when the archive was opened, the current
  384. '                                   file will be processed and the operation will be
  385. '                                   performed slower than a simple seek.
  386. '                                 RAR_TEST  : Test the current file and move to the
  387. '                                   next file in the archive. If the archive was opened
  388. '                                   with RAR_OM_LIST mode, the operation is equal to
  389. '                                   RAR_SKIP
  390. '                                 RAR_EXTRACT: Extract the current file and move to
  391. '                                   the next file. If the file was opened with
  392. '                                   RAR_OM_LIST mode, the operation is equal to RAR_SKIP
  393. '               DestPath        - points to a zero-terminated string containing the
  394. '                                 destination directory to which to extract files to.
  395. '                                 If DestPath is equal to NULL it means extract to the
  396. '                                 current directory. This parameters has meaning only
  397. '                                 if DestName is NULL
  398. '               DestName        - points to a string containing the full path and name
  399. '                                 of the file to be extracted of NULL as default. If
  400. '                                 DestName is defined (not NULL) it overrides the original
  401. '                                 file name saved in the archive and DestPath setting
  402. ' returns:  0                   - Success
  403. '           ERAR_BAD_DATA       - File CRC error
  404. '           ERAR_BAD_ARCHIVE    - Volume is not a valid RAR archive
  405. '           ERAR_UNKOWN_FORMAT  - Unknown archive format
  406. '           ERAR_EOPEN          - Volume open error
  407. '           ERAR_ECREATE        - File create error
  408. '           ERAR_ECLOSE         - File close error
  409. '           ERAR_EREAD          - Read error
  410. '           ERAR_EWRITE         - Write error
  411. Private Declare Function RARProcessFile Lib "unrar.dll" _
  412.                 (ByVal hArcData As Long, _
  413.                  ByVal Operation As Long, _
  414.                  ByVal DestPath As String, _
  415.                  ByVal DestName As Long) As Long
  416.  
  417. ' Set a user-defined function to process volume changing
  418. ' parameters:   hAcrData        - contains the archive handle obtained from the
  419. '                                 RAROpenArchive function call
  420. '               lpChangeVolProc - should point to a user-defined "volume change processing" function
  421. '                   This function will be passed two parameters:
  422. '                   ArcName     - points to a zero-terminated name of the next volume
  423. '                   Mode        - The function call mode
  424. '                                 RAR_VOL_ASK   : required volume is absent. The function should prompt the
  425. '                                       user and return a non-zero value to retry or return a zero value to
  426. '                                       terminate the operation. The function may also specify a new volume
  427. '                                       name, placing it to the ArcName parameter
  428. '                                 RAR_VOL_NOTIFY: Required volume is successfully opened. This is a notification
  429. '                                       call and ArcName modification is not allowed. The function should
  430. '                                       return a non-zero value to continue or a zero value to terminate operation.
  431. '                   Other functions of UNRAR.DLL should not be called from the ChangeVolProc function
  432. Private Declare Sub RARSetChangeVolProc Lib "unrar.dll" _
  433.                 (ByVal hArcData As Long, _
  434.                  ByVal lpChangeVolProc As Long)
  435.                  
  436. ' Set a user-defined function to process unpacked data.
  437. ' It may be used to read a file while it is being extracted or tested without
  438. ' actual extracting file to disk.
  439. ' parameters:   hAcrData        - contains the archive handle obtained from the
  440. '                                 RAROpenArchive function call
  441. '               lpProcessDataProc - should point to a user-defined "data processing" function
  442. '                   This function is called each time when the next data portion is unpacked.
  443. '                   It will be passed two parameters:
  444. '                   Addr        - The address pointing to the unpacked data. The function may refer to the
  445. '                                 the data but must not change it.
  446. '                   Size        - The size of the unpacked data. It is guaranteed only the size will not
  447. '                                 exceed 1 MB (1.048.576 bytes). Any other presumptions may not be correct
  448. '                                 for future implementations of UNRAR.DLL
  449. '                   The function should return a non-zero value to continue process or a zero value to
  450. '                   cancel the archive operation.
  451. '                   Other functions of UNRAR.DLL should not be called from the ChangeVolProc function
  452. Private Declare Sub RARSetProcessDataProc Lib "unrar.dll" _
  453.                 (ByVal hArcData As Long, _
  454.                  ByVal lpProcessDataProc As Long)
  455.                  
  456. ' Set a password to decrypt files
  457. ' It may be used to read a file while it is being extracted or tested without
  458. ' actual extracting file to disk.
  459. ' parameters:   hAcrData        - contains the archive handle obtained from the
  460. '                                 RAROpenArchive function call
  461. '               Password - should point to a string containing a zero terminated password
  462. Private Declare Sub RARSetPassword Lib "unrar.dll" _
  463.                 (ByVal hArcData As Long, _
  464.                  ByVal sPassword As String)
  465. Public Event FileFound( _
  466.         ByVal Index As Long, _
  467.         ByVal Total As Long, _
  468.         ByVal Filename As String, _
  469.         ByVal ArchiveExt As String, _
  470.         ByVal Modified As Date, _
  471.         ByVal Size As Long, _
  472.         ByVal CompSize As Long, _
  473.         ByVal Method As Long, _
  474.         ByVal Attr As Long, _
  475.         ByVal Path As String, _
  476.         ByVal flags As Long, _
  477.         ByVal Crc As Long, _
  478.         ByVal Comments As String)
  479.         
  480.         
  481. Private Sub GetZip()
  482.     'Copyright 2001 Dana Seaman
  483.     'Rewritten to:
  484.     '1: Get ZipFileEndCentralHeader
  485.     '2: Go direct to ZipFileCentralHeader
  486.     '3: Enumerate the entries
  487.     '4: Add to Listview
  488.     '5: 31Dec2001 Add network support
  489.     '   Replace VB Binary File I/O with API
  490.     
  491.         '<EhHeader>
  492.         On Error GoTo GetZip_Err
  493.         '</EhHeader>
  494.  
  495.     Dim Sig           As Long
  496.     Dim LenFile       As Long
  497.     Dim Index         As Long
  498.     Dim sPath         As String
  499.     Dim Filename      As String
  500.     Dim Temp          As String * 4096
  501.     Dim MyDate        As Date
  502.     Dim hFile         As Long
  503.     Dim bBuffer(10)   As Byte
  504.     Dim lResult       As Long
  505.     Dim lowbyte       As Long 'low dword of file pointer position
  506.     Dim highbyte      As Long 'high dword of file pointer position
  507.     Dim Ret           As Long
  508.     Dim MyPos         As Long
  509.     '-------------------------------------------------
  510.     'Dim zFile         As ZipFileLocalHeader
  511.     Dim zCentral      As ZipFileCentralHeader
  512.     Dim zEndCentral   As ZipFileEndCentralHeader
  513.     'Dim zSignature    As ZipDigitalSignature
  514.     '-------------------------------------------------
  515.     'Zip Signatures                          'a.k.a.
  516.     'Const LocalFileHeaderSig = &H4034B50    'PK 03 04
  517.     'Const CentralFileHeaderSig = &H2014B50  'PK 01 02
  518.     'Const EndCentralHeaderSig = &H6054B50   'PK 05 06
  519.     'Const DigitalSig = &H5054B50            'PK 05 05
  520.     'Const SpanSig = &H8074B50               'PK 07 08
  521.     Const Offset As Long = 4096
  522.  
  523. 100 hFile = CreateFile(ArchiveName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0&)
  524. 102 If hFile = INVALID_HANDLE_VALUE Then Exit Sub
  525. 104 LenFile = GetFileSize(hFile, 0)
  526.     If LenFile = 0 Then Exit Sub
  527.  
  528. 110 If LenFile > Offset Then
  529. 114    MyPos = LenFile - Offset
  530.     Else
  531. 118    MyPos = 1
  532.     End If
  533.     lowbyte = MyPos
  534.     highbyte = 0
  535.     lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  536.     ReadFile hFile, ByVal Temp, Offset, Ret, ByVal 0&
  537. 122 Sig = InStrRev(Temp, "PK" & Chr$(5) & Chr$(6))
  538. 124 If Sig Then
  539. 128    lowbyte = MyPos + Sig + 3
  540. 130    highbyte = 0
  541. 132    lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  542. 134    With zEndCentral
  543. 138       ReadFile hFile, .DiskNumberThis, 2, Ret, ByVal 0&
  544. 142       ReadFile hFile, .DiskNumberCentralDir, 2, Ret, ByVal 0&
  545. 146       ReadFile hFile, .CentralDirEntriesThisDisk, 2, Ret, ByVal 0&
  546. 150       ReadFile hFile, .CentralDirEntriesTotal, 2, Ret, ByVal 0&
  547. 154       ReadFile hFile, .SizeCentralDir, 4, Ret, ByVal 0&
  548. 158       ReadFile hFile, .CentralDirOffset, 4, Ret, ByVal 0&
  549.          ' Get ZipStream, , .FileCommentLength        'Integer
  550.          ' .FileComment = String$(.FileCommentLength, vbKeySpace)
  551.          ' Get ZipStream, , .FileComment              'String
  552. 160      ' Seek ZipStream, .CentralDirOffset + 1
  553. 162       lowbyte = .CentralDirOffset '+ 1
  554. 164       highbyte = 0
  555. 166       lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  556. 168       FileCount = .CentralDirEntriesThisDisk
  557.        End With
  558. 170    For Index = 1 To FileCount
  559. 172       With zCentral 'This has all the goodies
  560. 174          ReadFile hFile, Sig, 4, Ret, ByVal 0&
  561. 176          ReadFile hFile, .VersionMadeBy, 2, Ret, ByVal 0&
  562. 178          ReadFile hFile, .VersionNeededToExtract, 2, Ret, ByVal 0&
  563. 180          ReadFile hFile, .Flag, 2, Ret, ByVal 0&
  564. 182          ReadFile hFile, .CompressionMethod, 2, Ret, ByVal 0&
  565. 184          ReadFile hFile, .time, 2, Ret, ByVal 0&
  566. 186          ReadFile hFile, .date, 2, Ret, ByVal 0&
  567. 188          ReadFile hFile, .CRC32, 4, Ret, ByVal 0&
  568. 190          ReadFile hFile, .CompressedSize, 4, Ret, ByVal 0&
  569. 192          ReadFile hFile, .UncompressedSize, 4, Ret, ByVal 0&
  570. 194          ReadFile hFile, .FileNameLength, 2, Ret, ByVal 0&
  571. 196          ReadFile hFile, .ExtraFieldLength, 2, Ret, ByVal 0&
  572. 198          ReadFile hFile, .FileCommentLength, 2, Ret, ByVal 0&
  573. 200          ReadFile hFile, .DiskNumberStart, 2, Ret, ByVal 0&
  574. 202          ReadFile hFile, .InternalAttr, 2, Ret, ByVal 0&
  575. 204          ReadFile hFile, .ExternalAttr, 4, Ret, ByVal 0&
  576. 206          ReadFile hFile, .RelOffsetLocHdr, 4, Ret, ByVal 0&
  577. 208          .Filename = String$(.FileNameLength, vbKeySpace)
  578. 210          ReadFile hFile, ByVal .Filename, Len(.Filename), Ret, ByVal 0&
  579. 212          If .ExtraFieldLength Then
  580. 214             .ExtraField = String$(.ExtraFieldLength, vbKeySpace)
  581. 216             ReadFile hFile, ByVal .ExtraField, Len(.ExtraField), Ret, ByVal 0&
  582.              End If
  583. 218          If .FileCommentLength Then
  584. 220             .FileComment = String$(.FileCommentLength, vbKeySpace)
  585. 222             ReadFile hFile, ByVal .FileComment, Len(.FileComment), Ret, ByVal 0&
  586.              End If
  587.           End With
  588. 224       ParseFullPath zCentral.Filename, sPath, Filename
  589. 226       With zCentral
  590. 228          MyDate = GetMyDate(.date, .time)
  591. 230          RaiseEvent FileFound(Index, FileCount, Filename, ArchiveExt, MyDate, .UncompressedSize, .CompressedSize, .CompressionMethod, .ExternalAttr, sPath, .Flag, .CRC32, .FileComment)
  592.           End With
  593.        Next
  594.     End If
  595.  
  596. 234 CloseHandle (hFile)
  597.  
  598.         '<EhFooter>
  599.         Exit Sub
  600.  
  601. GetZip_Err:
  602.         MsgBox Err.Description & vbCrLf & _
  603.                "in cArchive.GetZip component " & _
  604.                "at line " & Erl
  605.         Resume Next
  606.         '</EhFooter>
  607. End Sub
  608. Private Sub GetAce()
  609. On Error GoTo ProcedureError
  610. Dim hArchive As Long
  611. Dim bMultiVolume As Boolean
  612. Dim sPath As String, Filename As String
  613. Dim Index As Long
  614. Dim sFile As String
  615. Dim zCentral As ACEHEADERDATA
  616. Dim MyDate As Date
  617. Dim Comments As String
  618.  
  619. '----Step thru just to get the total FileCount
  620.    hArchive = OpenACEArchive(ArchiveName, ACEOPEN_LIST, bMultiVolume)
  621.    If hArchive Then
  622.       While ACEReadHeader(hArchive, zCentral) = 0
  623.          sFile = StripNull(zCentral.Filename)
  624.          FileCount = FileCount + 1
  625.          ACEProcessFile hArchive, ACECMD_SKIP, vbNull
  626.       Wend
  627.       ACECloseArchive hArchive
  628.    End If
  629. '-----
  630.  
  631.    hArchive = OpenACEArchive(ArchiveName, ACEOPEN_LIST, bMultiVolume)
  632.    If hArchive Then
  633.       While ACEReadHeader(hArchive, zCentral) = 0
  634.          sFile = StripNull(zCentral.Filename)
  635.          Index = Index + 1
  636.          ParseFullPath sFile, sPath, Filename
  637.          With zCentral
  638.             MyDate = GetMyDate(.FileDate, .FileTime)
  639.             Comments = PointerToString(.CmtBuf)
  640.             RaiseEvent FileFound(Index, FileCount, Filename, ArchiveExt, MyDate, .UnpSize, .PackSize, .Method, .FileAttr, sPath, .flags, .FileCRC, Comments)
  641.          End With
  642.          ACEProcessFile hArchive, ACECMD_SKIP, vbNull
  643.       Wend
  644.       ACECloseArchive hArchive
  645.    End If
  646.  
  647.  
  648. ProcedureExit:
  649.    Exit Sub
  650. ProcedureError:
  651.    If ErrMsgBox("GetAce") = vbRetry Then Resume Next
  652. End Sub
  653.  
  654. Private Sub GetCab()
  655. 'Copyright 2001 Dana Seaman
  656. '   31Dec2001 Add network support
  657. '   Replace VB Binary File I/O with API
  658.     
  659.         '<EhHeader>
  660.         On Error GoTo GetCab_Err
  661.         '</EhHeader>
  662.  
  663. Dim Sig        As Long
  664. Dim Index      As Long
  665. Dim hFile         As Long
  666. Dim CabStream  As Integer
  667. Dim sPath      As String
  668. Dim Filename   As String
  669. Dim Temp       As String
  670. Dim MyDate     As Date
  671. Dim SeekPos    As Long
  672. Dim lResult    As Long
  673. Dim lowbyte    As Long 'low dword of file pointer position
  674. Dim highbyte   As Long 'high dword of file pointer position
  675. Dim Ret        As Long
  676. '-------------------------------------------------
  677.  
  678. Dim zCentral      As CabFileHeader
  679. Dim zFile         As CFFILE
  680. Dim zFolder       As CFFOLDER
  681. '-------------------------------------------------
  682.  
  683. 100 hFile = CreateFile(ArchiveName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0&)
  684. 102 If hFile = INVALID_HANDLE_VALUE Then Exit Sub
  685.  
  686. CabStream = FreeFile
  687.  
  688. Open ArchiveName For Binary As CabStream
  689.  
  690. Get CabStream, , zCentral
  691. ReadFile hFile, zCentral, 36, Ret, ByVal 0&
  692.  
  693. If zCentral.signature = "MSCF" Then
  694.    FileCount = zCentral.cFiles
  695.    If FileCount Then
  696.       If zCentral.cFolders Then
  697.          Get CabStream, , zFolder
  698.          ReadFile hFile, zFolder, 8, Ret, ByVal 0&
  699.       End If
  700.       SeekPos = zCentral.coffFiles '+ 1
  701.       Seek CabStream, SeekPos
  702.       lowbyte = SeekPos
  703.       highbyte = 0
  704.       lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  705.       For Index = 1 To FileCount
  706.          Get CabStream, , zFile
  707.          ReadFile hFile, zFile, 276, Ret, ByVal 0&
  708.          With zFile
  709.             Temp = StripNull(.szName)
  710.             ParseFullPath Temp, sPath, Filename
  711.             MyDate = GetMyDate(.date, .time)
  712.             RaiseEvent FileFound(Index, FileCount, Filename, ArchiveExt, MyDate, .uSize, 0, zFolder.typeCompress, .attribs, sPath, zCentral.flags, 0, "")
  713.             '260 bytes were read for .szname
  714.             'synchronize SeekPos for next block
  715.             SeekPos = SeekPos + Len(Temp) + 17
  716.             Seek CabStream, SeekPos
  717.             lowbyte = SeekPos
  718.             highbyte = 0
  719.             lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  720.          End With
  721.       Next
  722.    End If
  723.  
  724. End If
  725.  
  726.     Close CabStream
  727. 234 CloseHandle (hFile)
  728.         
  729.         '<EhFooter>
  730.         Exit Sub
  731.  
  732. GetCab_Err:
  733.         MsgBox Err.Description & vbCrLf & _
  734.                "in cArchive.GetCab component " & _
  735.                "at line " & Erl
  736.         Resume Next
  737.         '</EhFooter>
  738. End Sub
  739. Private Sub GetRar()
  740. On Error GoTo ProcedureError
  741.  
  742. Dim hArchive As Long
  743. Dim bMultiVolume As Boolean
  744. Dim sPath As String, Filename As String
  745. Dim MyDate As Date
  746. Dim zCentral As RARHEADERDATA
  747. Dim Index As Long
  748. Dim Comments As String
  749.  
  750. '--------Step thru just to get the total FileCount
  751.     hArchive = OpenRARArchive(ArchiveName, RAR_OM_LIST, bMultiVolume)
  752.     If hArchive = 0 Then Exit Sub
  753.     While RARReadHeader(hArchive, zCentral) = 0
  754.         RARProcessFile hArchive, RAR_SKIP, vbNull, 0&
  755.         If (zCentral.flags And &H1000) = 0 Then
  756.             ' file continued flag not set
  757.            FileCount = FileCount + 1
  758.         End If
  759.     Wend
  760.     RARCloseArchive hArchive
  761. '--------
  762.     hArchive = OpenRARArchive(ArchiveName, RAR_OM_LIST, bMultiVolume)
  763.     If hArchive = 0 Then Exit Sub
  764.     
  765.     While RARReadHeader(hArchive, zCentral) = 0
  766.         
  767.         RARProcessFile hArchive, RAR_SKIP, vbNull, 0&
  768.         If (zCentral.flags And &H1000) = 0 Then
  769.             ' file continued flag not set
  770.            Index = Index + 1
  771.            With zCentral
  772.               ParseFullPath StripNull(.Filename), sPath, Filename
  773.               MyDate = GetMyDate(.FileDate, .FileTime)
  774.               Comments = PointerToString(.CmtBuf)
  775.               RaiseEvent FileFound(Index, FileCount, Filename, ArchiveExt, MyDate, .UnpSize, .PackSize, .Method, .FileAttr, sPath, .flags, .FileCRC, Comments)
  776.             End With
  777.         End If
  778.     Wend
  779.            
  780.     RARCloseArchive hArchive
  781.  
  782. ProcedureExit:
  783.    Exit Sub
  784. ProcedureError:
  785.    If ErrMsgBox("GetRar") = vbRetry Then Resume Next
  786. End Sub
  787. Public Function GetInfo() As Boolean
  788.  
  789.    Select Case ArchiveExt
  790.       Case ace_: GetAce
  791.       Case cab_: GetCab
  792.       Case rar_: GetRar
  793.       Case zip_: GetZip
  794.    End Select
  795.  
  796. End Function
  797. Public Function OpenACEArchive(sFileName As String, _
  798.                 OpenMode As Long, _
  799.                 ByRef bMultiVolume As Boolean) As Long
  800.     Dim hArchive As Long
  801.     Dim tArchiveData As ACEOPENARCHIVEDATA
  802.     Dim ByteArray() As Byte
  803.     
  804.     ReDim ByteArray(0 To Len(sFileName)) As Byte
  805.     tArchiveData.Arcname = StringToPointer(sFileName, ByteArray)
  806.     tArchiveData.OpenMode = OpenMode ' parameter instead of constant
  807.     tArchiveData.CmtBufSize = 0
  808.     hArchive = ACEOpenArchive(tArchiveData)
  809.     If tArchiveData.OpenResult <> 0 Then
  810.         If hArchive <> 0 Then ACECloseArchive hArchive
  811.         OpenACEArchive = 0
  812.     Else
  813.         bMultiVolume = CBool(tArchiveData.flags & &H800)
  814.         OpenACEArchive = hArchive
  815.     End If
  816. End Function
  817.  
  818. Public Function UnpackACE(sFileName As String, sDestin As String) As Boolean
  819.     Dim hArchive As Long
  820.     Dim tHeaderdata As ACEHEADERDATA
  821.     Dim sFile As String
  822.     Dim bMultiVolume As Boolean
  823.     hArchive = OpenACEArchive(sFileName, ACEOPEN_EXTRACT, bMultiVolume)
  824.     If hArchive = 0 Then Exit Function
  825.  
  826.     While ACEReadHeader(hArchive, tHeaderdata) = 0
  827.         sFile = StripNull(tHeaderdata.Filename)
  828.         Select Case ACEProcessFile(hArchive, ACECMD_EXTRACT, sDestin)
  829.            Case ACEERR_WRITE
  830.               MsgBox "Could not write file to disk", vbCritical
  831.               ACECloseArchive hArchive
  832.               Exit Function
  833.            Case ACEERR_CRC
  834.               MsgBox "Crc Error on File " & sFile, vbInformation
  835.         End Select
  836.         
  837.         If tHeaderdata.FileAttr <> vbDirectory Then
  838.            'Show progress
  839.         End If
  840.         DoEvents
  841.     Wend
  842.     ACECloseArchive hArchive
  843. End Function
  844. Public Function OpenRARArchive(sFileName As String, _
  845.                 OpenMode As Long, _
  846.                 ByRef bMultiVolume As Boolean) As Long
  847.     Dim hArchive As Long
  848.     Dim tArchiveData As RAROPENARCHIVEDATA
  849.     Dim ByteArray() As Byte
  850.     
  851.     ReDim ByteArray(0 To Len(sFileName)) As Byte
  852.     tArchiveData.szArcName = StringToPointer(sFileName, ByteArray)
  853.     tArchiveData.OpenMode = OpenMode
  854.     tArchiveData.CmtBufSize = 0
  855.     hArchive = RAROpenArchive(tArchiveData)
  856.     If tArchiveData.OpenResult <> 0 Then
  857.         If hArchive <> 0 Then RARCloseArchive hArchive
  858.         OpenRARArchive = 0
  859.     Else
  860.         OpenRARArchive = hArchive
  861.     End If
  862. End Function
  863.  
  864. Public Function UnpackRAR(sFileName As String, sDestin As String) As Boolean
  865.     Dim hArchive As Long
  866.     Dim tHeaderdata As RARHEADERDATA
  867.     Dim sFile As String
  868.     Dim bMultiVolume As Boolean
  869.     
  870.     hArchive = OpenRARArchive(sFileName, RAR_OM_EXTRACT, bMultiVolume)
  871.     If hArchive = 0 Then Exit Function
  872.  
  873. '    RARSetChangeVolProc hArchive, FnPtr(AddressOf ChangeVolProc)
  874. '    RARSetProcessDataProc hArchive, FnPtr(AddressOf ProcessDataProc)
  875.     
  876.     sDestin = QualifyPath(sDestin)
  877.     
  878.     While RARReadHeader(hArchive, tHeaderdata) = 0
  879.         sFile = StripNull(tHeaderdata.Filename)
  880.         Select Case RARProcessFile(hArchive, RAR_EXTRACT, sDestin, 0&)
  881.            Case ERAR_EWRITE
  882.               MsgBox "Write error", vbCritical
  883.               RARCloseArchive hArchive
  884.               Exit Function
  885.            Case ERAR_EREAD
  886.                 MsgBox "Archive " & sFile & " Read Error.", vbInformation + vbOKOnly
  887.         End Select
  888.         
  889.         If tHeaderdata.FileAttr <> vbDirectory Then
  890.           'Show progress here
  891.         End If
  892.         
  893.         DoEvents
  894.     Wend
  895.     RARCloseArchive hArchive
  896. End Function
  897.  
  898. Public Function ChangeVolProc(ByRef sArcName As String, ByVal lMode As Long) As Long
  899.     Debug.Print sArcName & " " & CStr(lMode)
  900.     ChangeVolProc = 1&
  901. End Function
  902.  
  903. Public Function ProcessDataProc(ByVal lAddr As Long, ByVal lSize As Long) As Long
  904.     Debug.Print "SIZE: " & CStr(lSize)
  905.     ProcessDataProc = 1&
  906. End Function
  907.  
  908.  
  909.